home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
node2src.zip
/
RBBSSUB1.BAS
< prev
next >
Wrap
BASIC Source File
|
1990-11-07
|
89KB
|
2,694 lines
' $linesize:132
' $title: 'RBBS-SUB1.BAS CPC17.3, Copyright 1986-90 by D. Thomas Mack'
' Copyright 1990 by D. Thomas Mack, all rights reserved.
' Name ...............: RBBSSUB1.BAS
' First Released .....: February 4, 1990
' Subsequent Releases.:
' Copyright ..........: 1986-1990
' Purpose.............:
' Subprorams that require error trapping are incorporated
' within RBBSSUB1.BAS as separately callable subroutines
' in order to free up as much code as possible within
' the 64WasK code segment used by RBBS-PC.BAS.
' Parameters..........: Most parameters are passed via a COMMON statement.
'
' Subroutine Line Function of Subroutine
' Name Number
' ChangeDir 20101 Change subdirectory
' CheckInt 58360 Check input is valid integer
' CommPut 59275 Write string to communications port
' FileLock 21993 Allow files to be shared among multiple RBBS-PC's 'Pe 02/04/90
' FindFile 59790 Determine whether a file exists without opening it ' AC012601
' FindFree 51098 Find amount of space on the upload disk drive
' FindItX 20219 Find if a file exists on a device ' KG061001
' FindUser 12598 Find a user in the USERS file
' FlushCom 20308 Read all characters in the communications port
' GetCom 1418 Read a character from the communications port
' GetPassword 58280 Read RBBS-PC's "PASSWORD" file
' GETWRK 58330 Read record from file number 2
' KillWork 58258 Delete a RBBS-PC "WORK" file
' NetBIOS 20898 Lock/Unlock NetBIOS semaphore files
' OpenCom 200 Open communications port (number 3)
' OpenFMS 58188 Open the upload management system directory
' OpenOutW 28218 Open RBBS-PC's "WORK" file (number 2) for output
' OpenRSeq 1479 Open a sequential file (number 2) for random I/O
' OpenUser 9398 Open the USER file (number 5)
' OpenWork 57978 Open RBBS-PC's work file (number 2)
' OpenWorkA 58340 Open RBBS-PC's "WORK" file (number 2) for append
' Printit 13673 Print line on the local PC printer
' PrintWork 58320 Print string to file #2 w/o CR/LF
' PrintWorkA 58350 Print string to file #2 with CR/LF
' PutCom 59650 Write to the communications port
' PutWork 59660 Write to work file randomly
' RBBSPlay 59680 Plays a musical string
' ReadAny 58310 Read file number 2 into ZOutTxt$
' ReadDef 112 Read configuration file
' ReadDir 58290 Read entire lines
' ReadParms 58300 Read certain number of parameters from file 2
' Talk 59700 RBBS-PC Voice synthesizer support for sight impaired
' SetCall 108 Find where next callers record is
' UpdateC 43048 Update the caller's file with elasped session time
' UpdtCalr 13661 Update to the caller's file
' ViewTxt 60140 Display ASCII file from Compressed file 'Pe 02/03/90
'
' $INCLUDE: 'RBBS-VAR.BAS'
'
108 ' $SUBTITLE: 'SetCall - subroutine to find last callers rec'
' $PAGE
'
' NAME -- SetCall
'
' INPUTS -- PARAMETER MEANING
'
' OUTPUTS -- ZCallersFileIndex!
'
' PURPOSE -- To find where to leave off on callers file
'
SUB SetCall STATIC
ON ERROR GOTO 65000
IF PrevCaller$ = ZCallersFile$ OR ZCallersFilePrefix$ = "" THEN _
EXIT SUB
PrevCaller$ = ZCallersFile$
ZCallersFileIndex! = 1
CLOSE 2
CLOSE 4
IF ZShareIt THEN _
OPEN ZCallersFile$ FOR RANDOM SHARED AS #4 LEN=64 _
ELSE OPEN "R",4,ZCallersFile$,64
FIELD 4,64 AS ZCallersRecord$
IF LOF(4) > 0 THEN _
ZCallersFileIndex! = LOF(4) / 64
IF ZCallersFileIndex! < 1 THEN _
ZCallersFileIndex! = 0
ZUserIn$ = STRING$(13,0)
110 GET 4,ZCallersFileIndex!
IF ZErrCode > 0 THEN _
ZErrCode = 0 : _
ZCallersFileIndex! = 0 : _
EXIT SUB
IF LEFT$(ZCallersRecord$,13) = ZUserIn$ THEN _
ZCallersFileIndex! = ZCallersFileIndex! - 1 : _
GOTO 110
END SUB
112 ' $SUBTITLE: 'ReadDef - subroutine to read RBBS-PC.DEF file'
' $PAGE
'
' NAME -- ReadDef
'
' INPUTS -- PARAMETER MEANING
' ZConfigFileName$ NAME OF RBBS-PC.DEF FILE
' ZSubParm = -62 ONLY READ THE .DEF FILE
'
' OUTPUTS -- ALL THE RBBS-PC.DEF PARAMETERS
'
' PURPOSE -- TO READ THE PARAMETERS FROM THE RBBS-PC.DEF FILE
'
SUB ReadDef (ConfigFile$) STATIC
ON ERROR GOTO 65000
'
' **** OPEN AND READ RBBS-PC CONFIGURATION DEFINITIONS ***
'
117 IF ZSubParm <> -62 THEN _
IF PrevRead$ = ConfigFile$ THEN _
EXIT SUB _
ELSE PrevRead$ = ConfigFile$
CLOSE 2
ZBulletinSave$ = ZBulletinMenu$
CALL OpenWork (2,ConfigFile$)
ZCurDef$ = ConfigFile$
INPUT #2,ZWasDF$, _
ZDnldDrives$, _
ZSysopPswd1$, _
ZSysopPswd2$, _
ZSysopFirstName$, _
ZSysopLastName$, _
ZRequiredRings, _
ZStartOfficeHours, _
ZEndOfficeHours, _
ZMinsPerSession, _ ' DA111103
ZWasDF, _
ZWasDF, _
ZUpldDir$, _
ZExpertUserDef, _
ZActiveBulletins, _
ZPromptBellDef, _
ZWasDF, _
ZMenusCanPause, _
ZMenu$(1), _
ZMenu$(2), _
ZMenu$(3), _
ZMenu$(4), _
ZMenu$(5), _
ZMenu$(6), _
ZConfMenu$, _
ZWasDF, _
ZWelcomeInterruptable, _
ZRemindFileXfers, _
ZPageLengthDef, _ ' KG080801
ZMaxMsgLinesDef, _
ZDoorsAvail, _
ZWasDF$, _
ZMainMsgFile$, _
ZMainMsgBackup$
INPUT #2, WasX$, _
ZCmntsFile$, _
ZMainUserFile$, _
ZWelcomeFile$, _
ZNewUserFile$, _
ZMainDirExtension$
CALL BreakFileName (WasX$,ZWasY$,ZWasDF$,ZWasZ$,ZFalse)
IF ZWasDF$ <> "" THEN _ ' RB060403
ZCallersFile$ = WasX$
INPUT #2, ZWasDF$
IF ZComPort$ <> "COM0" THEN _
IF NOT ZConfMode THEN _
ZComPort$ = ZWasDF$
INPUT #2, ZBulletinsOptional, _
ZModemInitCmd$, _
ZRTS$, _
ZWasDF, _
ZFG, _
ZBG, _
ZBorder
IF ZConfMode THEN _
INPUT #2, ZWasDF$, _
ZWasDF$ _
ELSE INPUT #2, ZRBBSBat$ , _
ZRCTTYBat$
INPUT #2,ZOmitMainDir$, _
ZFirstNamePrompt$, _
ZHelp$(3), _
ZHelp$(4), _
ZHelp$(7), _
ZHelp$(9), _
ZBulletinMenu$, _
ZBulletinPrefix$, _
ZWasDF$, _
ZMsgReminder, _
ZRequireNonASCII, _
ZAskExtendedDesc, _
ZMaxNodes, _
ZNetworkType ' JM122202
IF ZConfMode THEN _ ' JM122202
INPUT #2, ZwasDF _ ' JM122202
ELSE INPUT #2, ZRecycleToDos ' JM122202
INPUT #2,ZWasDF, _ ' JM122202
ZWasDF, _
ZTrashcanFile$
INPUT #2,ZMinLogonSec, _
ZDefaultSecLevel, _ ' KG020901
ZSysopSecLevel, _
ZFileSecFile$, _
ZSysopMenuSecLevel, _
ZConfMailList$, _
ZMaxViolations, _
ZOptSec(50), _ ' SECURITY FOR Sysop COMMANDS 1
ZOptSec(51), _
ZOptSec(52), _
ZOptSec(53), _
ZOptSec(54), _
ZOptSec(55), _
ZOptSec(56), _ ' ZSysop 7
ZPswdFile$, _
ZMaxPswdChanges, _
ZMinSecForTempPswd, _
ZOverWriteSecLevel, _
ZDoorsTermType, _
ZMaxPerDay
INPUT #2,ZOptSec(1), _ ' SECURITY FOR MAIN MENU COMMANDS 1
ZOptSec(2), _
ZOptSec(3), _
ZOptSec(4), _
ZOptSec(5), _
ZOptSec(6), _
ZOptSec(7), _
ZOptSec(8), _
ZOptSec(9), _
ZOptSec(10), _
ZOptSec(11), _
ZOptSec(12), _
ZOptSec(13), _
ZOptSec(14), _
ZOptSec(15), _
ZOptSec(16), _
ZOptSec(17), _
ZOptSec(18), _ ' MAIN COMMAND 18
ZMinNewCallerBaud, _
ZWaitBeforeDisconnect
INPUT #2,ZOptSec(19), _ ' Security for FILE COMMANDS 1
ZOptSec(20), _
ZOptSec(21), _
ZOptSec(22), _
ZOptSec(23), _
ZOptSec(24), _
ZOptSec(25), _
ZOptSec(26), _ ' FILE COMMAND 8
ZOptSec(27), _ ' SECURITY FOR UTILITY COMMANDS 1
ZOptSec(28), _
ZOptSec(29), _
ZOptSec(30), _
ZOptSec(31), _
ZOptSec(32), _
ZOptSec(33), _
ZOptSec(34), _
ZOptSec(35), _
ZOptSec(36), _
ZOptSec(37), _
ZOptSec(38), _ ' UTIL COMMAND 12
ZOptSec(46), _ ' SECURITY FOR GLOBAL COMMANDS 1
ZOptSec(47), _
ZOptSec(48), _
ZOptSec(49), _
ZUpldTimeFactor!, _
ZComputerType, _
ZRemindProfile, _
ZRBBSName$, _
ZCmdsBetweenRings, _
ZMNPSupport, _
ZPagingPtrSupport$ ' RK122301
IF ZConfMode THEN _ ' RK122301
INPUT #2, ZwasDF _ ' RK122301
ELSE INPUT #2, ZModemInitBaud$ ' RK122301
IF ZErrCode > 0 THEN _
EXIT SUB
118 INPUT #2, ZTurnPrinterOff,_ ' Turn printer off each recycle
ZDirPath$, _ ' Where dir files are stored
ZMinSecToView, _
ZLimitSearchToFMS, _
ZDefaultCatCode$, _
ZDirCatFile$, _
ZNewFilesCheck, _
ZMaxDescLen, _
ZShowSection, _
ZCmndsInPrompt, _
ZNewUserSetsDefaults, _
ZHelpPath$, _
ZHelpExtension$, _
ZMainCmds$, _
ZFileCmd$, _
ZUtilCmds$, _
ZGlobalCmnds$, _
ZSysopCmds$
INPUT #2, ZRecycleWait, _
ZOptSec(39), _ ' SECURITY FOR Library COMMANDS 1
ZOptSec(40), _
ZOptSec(41), _
ZOptSec(42), _
ZOptSec(43), _
ZOptSec(44), _
ZOptSec(45), _ ' Library COMMANDS 7
ZLibDrive$, _
ZLibDirPath$, _
ZLibDirExtension$, _
ZLibWorkDiskPath$, _
ZLibMaxDisk, _
ZLibMaxDir, _
ZLibMaxSubdir, _
ZLibSubdirPrefix$, _
ZLibArcPath$, _
ZLibArcProgram$, _
ZLibCmds$
'
' ***** ESTABLISH COMMUNICATION PORT REGISTERS AND COMMANDS ***
' ***** GET DOS SUB-DIRECTORY RBBS-PC OPTIONS ***
'
INPUT #2, ZUpldPath$, _ ' Where upl dir goes
ZMainFMSDir$, _ ' Shared dir in FMS
ZAnsMenu$, _
ZReqQues$,_
ZRememberNewUsers,_
ZSurviveNoUserRoom,_
ZPromptHash$,_
ZStartHash,_
ZLenHash,_
ZPromptIndiv$,_
ZStartIndiv,_
ZLenIndiv
INPUT #2, ZBypassMsgs, _
ZMusic, _
ZRestrictByDate, _
ZDaysToWarn, _
ZDaysInRegPeriod, _
ZVoiceType, _
ZRestrictValidCmds, _
ZNewUserDefaultMode, _
ZNewUserLineFeeds, _
ZArkViewPath$, _ 'Pe 02/04/90
ZFastFileList$, _ ' KG102201
ZFastFileLocator$, _ ' KG102201
ZMsgsCanGrow, _
ZWrapCallersFile$, _
ZRedirectIOMethod, _
ZAutoUpgradeSec, _
ZHaltOnError, _
ZNewPublicMsgsSec, _
ZNewPrivateMsgsSec, _
SecNeededToChangeMsgs, _
ZSLCategorizeUplds, _
ZBaudot, _
ZHourMinToDropToDos, _
ZExpiredSec, _
ZDTRDropDelay, _
ZAskID, _
ZMaxRegSec, _
ZBufferSize, _
ZMLCom, _
ZNoDoorProtect, _
ZDefaultExtension$, _
ZNewUserDefaultProtocol$, _
ZNewUserGraphics$, _
ZNetMail$, _
ZMasterDirName$, _
ZProtoDef$, _
ZUpcatHelp$, _
ZAllwaysStrewTo$, _
ZLastNamePrompt$
119 INPUT #2, ZPersonalDrvPath$, _
ZPersonalDir$, _
ZPersonalBegin, _
ZPersonalLen, _
ZPersonalProtocol$, _
ZPersonalConcat , _
ZPrivateReadSec, _
ZPublicReadSec, _
ZSecChangeMsg ' RK122301
IF ZConfMode THEN _ ' RK122301
INPUT #2, ZwasDF _ ' RK122301
ELSE INPUT #2, ZKeepInitBaud ' RK122301
INPUT #2, ZMainPUI$ ' RK122301
IF ZConfMode THEN _
INPUT #2, ZWasDF$,ZWasDF$,ZWasDF$ _
ELSE INPUT #2, ZDefaultEchoer$, _
ZHostEchoOn$, _
ZHostEchoOff$
INPUT #2, ZSwitchBack, _
ZDefaultLineACK$, _
ZAltdirExtension$, _
ZDirPrefix$
IF ZConfMode THEN _
INPUT #2, ZWasDF, _
ZWasDF, _
ZWasDF _
ELSE INPUT #2, ZWasDF,_
ZModemInitWaitTime, _
ZModemCmdDelayTime
INPUT #2, ZTurboRBBS, _
ZSubDirCount, _
ZWasDF, _
ZUpldToSubdir, _
ZWasDF, _
ZUpldSubdir$, _
ZMinOldCallerBaud, _
ZMaxWorkVar, _
ZDiskFullGoOffline, _
ZExtendedLogging
IF ZConfMode THEN _
INPUT #2, ZWasDF$, _
ZWasDF$, _
ZWasDF$, _
ZWasDF$ _
ELSE INPUT #2, ZModemResetCmd$, _
ZModemCountRingsCmd$, _
ZModemAnswerCmd$, _
ZModemGoOffHookCmd$
INPUT #2,ZDiskForDos$, _
ZDumbModem, _
ZCmntsAsMsgs
IF ZConfMode THEN _
INPUT #2, ZWasDF, _
ZWasDF, _
ZWasDF, _
ZWasDF, _
ZWasDF, _
ZWasDF _
ELSE INPUT #2, ZLSB,_
ZMSB,_
ZLineCntlReg,_
ZModemCntlReg,_
ZLineStatusReg,_
ZModemStatusReg
INPUT #2,ZKeepTimeCredits, _
ZXOnXOff, _
ZAllowCallerTurbo, _
ZUseDeviceDriver$, _
ZPreLog$, _
ZNewUserQuestionnaire$, _
ZEpilog$, _
ZRegProgram$, _
ZQuesPath$, _
ZUserLocation$, _
ZWasDF$, _
ZWasDF$, _
ZWasDF$, _
ZEnforceRatios, _
ZSizeOfStack, _
ZSecExemptFromEpilog, _
ZUseBASICWrites, _
ZDosANSI, _
ZEscapeInsecure, _
ZUseDirOrder, _
ZAddDirSecurity, _
ZMaxExtendedLines, _
ZOrigCommands$
INPUT #2,ZLogonMailLevel$, _
ZMacroDrvPath$, _
ZMacroExtension$, _
ZEmphasizeOnDef$, _
ZEmphasizeOffDef$, _
ZFG1Def$, _
ZFG2Def$, _
ZFG3Def$, _
ZFG4Def$, _
ZSecVioHelp$
IF ZConfMode THEN _
INPUT #2,ZWasDF _
ELSE INPUT #2,ZFossil
INPUT #2,ZMaxCarrierWait, _
ZWasDF, _
ZSmartTextCode, _
ZTimeLock, _
ZWriteBufDef, _
ZSecKillAny, _
ZDoorsDef$, _
ZScreenOutMsg$, _
ZAutoPageDef$
IF ZErrCode > 0 THEN _
EXIT SUB
ZConfigFileName$ = ConfigFile$
' CALL UnString(ZEmphasizeOnDef$,";40") 'ANSIEd ' Bh 110790
' CALL UnString(ZEmphasizeOffDef$,";40") '
' CALL UnString(ZFG1Def$,";40") '
' CALL UnString(ZFG2Def$,";40") '
' CALL UnString(ZFG3Def$,";40") '
' CALL UnString(ZFG4Def$,";40") '
CALL EditDef
END SUB
200 ' $SUBTITLE: 'OpenCom - subroutine to open the communications port'
' $PAGE
'
' NAME -- OpenCom
'
' INPUTS -- PARAMETER MEANING
' BaudRate$ BAUD TO OPEN MODEM
' Parity$ PARITY TO OPEN MODEM
'
' OUTPUTS -- BaudTest! BAUD RATE TO SET RS232 AT
'
' PURPOSE -- To open the communications port.
'
SUB OpenCom (BaudRate$,Parity$) STATIC
ON ERROR GOTO 65000
IF INSTR(Parity$,"N") THEN _
Parity = 2 : _ ' No PARITY
DataBits = 3 : _ ' 8 DATA BITS
StopBits = 0 _ ' 1 STOP BIT
ELSE Parity = 3 : _ ' EVEN PARITY
DataBits = 2 : _ ' 7 DATA BITS
StopBits = 0 ' 1 STOP BIT
202 CLOSE 3 ' RK010401
IF ZRTS$ = "YES" THEN _
ZFlowControl = ZTrue : _
WasX$ = ",CS26600,CD,DS" _
ELSE WasX$ = ",RS,CD,DS"
WasX = (VAL(BaudRate$) > 19200) ' KG092503
IF WasX THEN _ ' KG092503
ZWasY$ = "19200" _ ' KG092503
ELSE ZWasY$ = BaudRate$ ' KG092503
OPEN ZComPort$ + ":" + ZWasY$ + Parity$ + WasX$ AS #3 ' KG092503
'
' ****************************************************************************
' * RAISE THE RTS SIGNAL IF THE MODEM USES RTS FOR MODEM FLOW CONTROL (ONCE
' * IT IS RAISED, IT WILL STAY UP UNTIL THE REGISTER IS CLEARED OUT).
' ****************************************************************************
'
END SUB
1418 ' $SUBTITLE: 'GetCom -- subroutine reads a char. from comm. port'
' $PAGE
'
' NAME -- GetCom
'
' INPUTS -- PARAMETER MEANING
' Strng$ STRING TO READ A CHARACTER INTO FROM
' THE COMMUNICATIONS PORT (FILE #3)
'
' OUTPUTS -- Strng$
'
' PURPOSE -- Reads a character from the communications port.
'
SUB GetCom (Strng$) STATIC
ON ERROR GOTO 65000
1420 Strng$ = INPUT$(1,3)
1421 IF ZErrCode = 57 THEN _
LineStatus = INP(ZLineStatusReg) : _
ZErrCode = 0 : _
GOTO 1420
END SUB
1479 ' $SUBTITLE: 'OpenRSeq - open sequential file randomly'
' $PAGE
'
' NAME -- OpenRSeq
'
' INPUTS -- PARAMETER MEANING
' FilName$ NAME OF SEQUENTIAL FILE TO OPEN AS #2
'
' OUTPUTS -- NumRecs NUMBER OF 128-BYTE RECORDS IN THE FILE
' LenLastRec NUMBER OF BYTES IN THE LAST RECORD (IT
' MAY BE LESS THAN OR EQUAL TO 128).
'
' PURPOSE -- Open a sequential file as file #2 and read it randomly
'
SUB OpenRSeq (FilName$,NumRecs,LenLastRec,RecLen) STATIC
ON ERROR GOTO 65000
CLOSE 2
1480 ZErrCode = 0
1481 IF ZShareIt THEN _
OPEN FilName$ FOR RANDOM SHARED AS #2 LEN=RecLen _
ELSE OPEN "R",2,FilName$,RecLen
IF ZErrCode = 52 THEN _
GOTO 1480
FIELD #2, RecLen AS ZDnldRecord$
WasI# = LOF(2)
NumRecs = FIX(WasI#/RecLen)
LenLastRec = WasI# - CDBL(NumRecs) * RecLen
IF LenLastRec > 0 THEN _
NumRecs = NumRecs + 1 _
ELSE LenLastRec = RecLen
END SUB
9398 ' $SUBTITLE: 'OpenUser - subroutine to open users file as #5'
' $PAGE
'
' NAME -- OpenUser
'
' INPUTS -- PARAMETER MEANING
' ZShareIt
'
' OUTPUTS -- ZActiveUserFile$
' ZCityState$
' ZElapsedTime$
' ZLastDateTimeOn$
' LastRec # OF Last RECORD IN USERS FILE
' ZListNewDate$
' ZPswd$
' ZSecLevel$
' ZUserDnlds$
' ZUserName$
' ZUserOption$
' ZUserRecord$
' ZUserUplds$
'
' PURPOSE -- Open the user file as file #5
'
SUB OpenUser (LastRec) STATIC
ON ERROR GOTO 65000
'
' **** OPEN AND DEFINE USER FILE RECORD VARIABLES ****
'
9400 CLOSE 5
IF ZShareIt THEN _
OPEN ZActiveUserFile$ FOR RANDOM SHARED AS #5 LEN=128 _
ELSE OPEN "R",5,ZActiveUserFile$,128
WasI# = LOF(5)
LastRec = FIX(WasI#/128)
FIELD 5,31 AS ZUserName$, _
15 AS ZPswd$, _
2 AS ZSecLevel$, _
14 AS ZUserOption$, _
24 AS ZCityState$, _
2 AS MachineType$, _
1 AS ZBankTime$,_ 'SRK030690
4 AS ZTodayDl$, _
4 AS ZTodayBytes$, _
4 AS ZDlBytes$, _
4 AS ZULBytes$, _
14 AS ZLastDateTimeOn$, _
3 AS ZListNewDate$, _
2 AS ZUserDnlds$, _
2 AS ZUserUplds$, _
2 AS ZElapsedTime$
FIELD 5,128 AS ZUserRecord$
END SUB
12598 ' $SUBTITLE: 'FindUser - subroutine to search users file for a name'
' $PAGE
'
' NAME -- FindUser
'
' INPUTS -- PARAMETER MEANING
' HashToLookFor$ STRING TO SEARCH FOR IN USERS
' IndivToLookFor$ STRING TO USE TO INDIVIDUATE
' USERS WITH SAME HASH
' StartHashPos WHERE HASH FIELD STARTS IN THE
' "USERS" FILE
' LenHashField LENGTH OF THE HASH FIELD
' StartIndivPos WHERE THE FIELD TO DISTINGUISH
' AMONG USERS (I.E. WITH THE SAME
' NAME) STARTS IN THE "USERS" FILE
' (SET TO 0 IF NONE TO BE USED)
' LenIndivField LENGTH OF FIELD TO DISTINGUISH
' AMONG USERS
' MaxPosition HIGHEST RECORD TO SEARCH OR USE
'
' NOTE: THIS SUBROUTINE ASSUMES THE "USERS" FILE IS OPEN AS FILE 2.
'
' OUTPUTS -- WhetherFound SET TO "TRUE" IF USER WAS Found
' OTHERWISE IT IS "FALSE"
' PosToUse NUMBER OF THE "USERS" RECORD THAT
' BELONGS TO THE USER (IF Found) OR
' TO USE FOR THE USER (IF THE USER
' WASN'T Found)
' PosToReclaim SET TO 0 IF THE RECORD NUMBER
' SELECTED FOR THIS USER HAS NEVER
' BEEN USED.
'
' PURPOSE -- To search the "USERS" file and determine the record
' number to use for the caller in the "USERS" file.
'
SUB FindUser (HashToLookFor$,IndivToLookFor$,StartHashPos,_
LenHashField,StartIndivPos,LenIndivField,_
MaxPosition,WhetherFound,_
PosToUse,PosToReclaim) STATIC
ON ERROR GOTO 65000
ZErrCode = 0
WhetherFound = 0
IF HashToLookFor$ = SPACE$(LEN(HashToLookFor$)) THEN _
EXIT SUB
EmptyRec$ = SPACE$(LenHashField)
EmptyIndiv$ = SPACE$(LenIndivField)
NewUser$ = LEFT$("NEWUSER ",LenHashField + 2)
FIELD 5, 128 AS Filler$
WasX$ = HashToLookFor$ + SPACE$(LenHashField - LEN(HashToLookFor$))
CALL HashRBBS (HashToLookFor$,MaxPosition,PosToUse,ZWasDF)
12600 ZWasY$ = IndivToLookFor$ + SPACE$(LenIndivField - LEN(IndivToLookFor$))
PosToReclaim = 0
12610 GET 5,PosToUse
IF ZErrCode > 0 THEN _
IF ZErrCode = 63 THEN _
ZErrCode = 0 : _
GOTO 12621 _
ELSE ZErrCode = 0 : _
GOTO 12620
HashValue$ = MID$(Filler$,StartHashPos,LenHashField)
IF WasX$ = HashValue$ THEN _
IF StartIndivPos < 1 THEN _
WhetherFound = ZTrue : _
GOTO 12622 _
ELSE IndivValue$ = MID$(Filler$,StartIndivPos,LenIndivField) : _
IF ZWasY$ = IndivValue$ OR IndivValue$ = EmptyIndiv$ THEN _
WhetherFound = ZTrue : _
GOTO 12622
IF HashValue$ = EmptyRec$ THEN _
PosToUse = PosToReclaim - (PosToReclaim = 0) * PosToUse : _
WhetherFound = ZFalse : _
GOTO 12622
IF ASC(HashValue$) = 0 OR INSTR(HashValue$,NewUser$) = 1 THEN _
IF PosToReclaim = 0 THEN _
PosToReclaim = PosToUse
12620 PosToUse = PosToUse + ZWasDF
IF PosToUse > MaxPosition - 1 THEN _
PosToUse = PosToUse - MaxPosition
GOTO 12610
12621 IF PosToReclaim = 0 THEN _
PosToReclaim = PosToUse
GOTO 12620
12622 END SUB
13661 ' $SUBTITLE: 'UpdtCalr - subroutine to write to CALLERS file'
' $PAGE
'
' NAME -- UpdtCalr
'
' INPUTS -- PARAMETER MEANING
' ErrMsg$ MESSAGE TO GO IN CALLER LOG
' EXTLog = 1 CHECK FOR EXTENDED LOGGING
' BEFORE UPDATING.
' = 2 UPDATE CALLER LOG WITH ZWasZ$
'
' OUTPUTS -- ZCurDate$ CURRENT DATE (MM-DD-YY)
' ZTime$ CURRENT TIME (I.E. 1:13 PM)
' TIME.LOGGEND.ON$ TIME USER LOGGED ON (HH:MM:SS)
'
' PURPOSE -- To update the caller's file and/or print on the
' local printer if it is enabled
'
SUB UpdtCalr (ErrMsg$,EXTLog) STATIC
ON ERROR GOTO 65000
IF ZCallersFilePrefix$ = "" OR (ZLocalUser AND ZSysop) THEN _
EXIT SUB
WasX$ = " " + ErrMsg$
13663 ZErrCode = 0
FIELD 4, 64 AS ZCallersRecord$
IF ZErrCode > 0 THEN _
CALL QuickTPut1 ("Caller's file: error"+STR$(ZErrCode)) : _
ZErrCode = 0 : _
EXIT SUB
ON EXTLog GOTO 13665,13670
'
' **** EXTENDED LOGGING ENTRY ***
'
13665 IF NOT ZExtendedLogging THEN _
EXIT SUB
CALL AMorPM ' KG061203
WasX$ = WasX$ + " at " + ZTime$
'
' **** UPDATE CALLERS FILE WITH USER ACTIVITY ****
'
13670 LSET ZCallersRecord$ = WasX$
CALL Printit (ZCallersRecord$)
IF ZLocalUser AND ZPrinter THEN _
EXIT SUB
ZCallersFileIndex! = ZCallersFileIndex! + 1
13672 PUT 4,ZCallersFileIndex!
END SUB
13673 ' $SUBTITLE: 'Printit - subroutine to print on the local printer'
' $PAGE
'
' NAME -- Printit
'
' INPUTS -- PARAMETER MEANING
' Strng$ STRING TO WRITE TO THE Printer
'
' OUTPUTS -- NONE
'
' PURPOSE -- To write to the printer attached to the pc running
' RBBS-PC and toggle the printer switch off whenever
' the printer is/becomes unavailable
'
SUB Printit (Strng$) STATIC
ON ERROR GOTO 65000
13674 IF ZPrinter THEN _
LPRINT Strng$
END SUB
20101 ' $SUBTITLE: 'ChangeDir - subroutine to change subdirectories'
' $PAGE
'
' NAME -- ChangeDir
'
' INPUTS -- PARAMETER MEANING
' NewDir$ NAME OF SUBDIRECTORY
'
' OUTPUTS -- ZOK TRUE IF CHDIR SUCCESSFUL
' ZErrCode ERROR CODE
'
' PURPOSE -- Change subdirectory
'
SUB ChangeDir (NewDir$) STATIC ' KG123103
ON ERROR GOTO 65000
ZErrCode = 0
ZOK = ZTrue
20103 CHDIR NewDir$ ' KG123103
END SUB
20219 ' $SUBTITLE: 'FINDITX - subroutine to find if a file exists'
' $PAGE
'
' NAME -- FINDITX
'
' INPUTS -- PARAMETER MEANING
' FilName$ NAME OF FILE TO FIND
' FileNum # TO OPEN FILE AS ' KG061001
'
' OUTPUTS -- ZOK TRUE IF FILE EXISTS
' ZErrCode ERROR CODE
'
' PURPOSE -- Determine whether a file exists
'
SUB FindItX (FilName$,FileNum) STATIC ' KG061001
ON ERROR GOTO 65000
ZErrCode = 0
ZOK = ZFalse
IF LEN(FilName$) < 1 THEN _
EXIT SUB
IF ZTurboRBBS THEN _
CALL FindFile (FilName$,ZOK) : _
IF ZOK THEN _
GOTO 20222 _
ELSE EXIT SUB
20221 CALL BadFileChar (FilName$,ZOK)
IF NOT ZOK THEN _
EXIT SUB
ZOK = ZFalse
NAME FilName$ AS FilName$
IF ZErrCode = 53 THEN _
ZErrCode = 0 : _ ' AC082901
EXIT SUB
20222 CLOSE FileNum ' KG061001
20223 CALL OpenWork (FileNum,FilName$) ' KG061001
IF ZErrCode = 64 OR ZErrCode = 76 THEN _
ZOK = ZFalse : _ ' KG012603
EXIT SUB
ZOK = ZTrue
END SUB
20308 ' $SUBTITLE: 'FlushCom -- subroutine reads all char. from comm. port'
' $PAGE
'
' NAME -- FlushCom
'
' INPUTS -- PARAMETER MEANING
' STrng$ STRING TO READ CHARACTERS INTO FROM
' THE COMMUNICATIONS PORT (FILE #3)
'
' OUTPUTS -- Strng$
'
' PURPOSE -- Reads all characters from the communications port.
'
SUB FlushCom (Strng$) STATIC
ON ERROR GOTO 65000
IF ZLocalUser THEN _
EXIT SUB
Strng$ = ""
20310
20311 Strng$ = INPUT$(LOC(3),3) ' FLUSH THE COMM BUFFER
20312 IF ZErrCode = 57 THEN _
LineStatus = INP(ZLineStatusReg) : _
ZErrCode = 0 : _
GOTO 20311
END SUB
'
' 'Pe 02/04/90 Moved FileLock sub here for Error Traping
21993 ' $SUBTITLE: 'FileLock - subroutine to share RBBS-PC files'
' $PAGE
'
' NAME -- FileLock
'
' INPUTS -- PARAMETER MEANING
' ZSubParm = 1 UNLOCK USERS AND MESSAGES
' 2 FLUSH MESSAGE RECORD TO DISK
' AND UNLOCK MESSAGES
' 3 LOCK MESSAGE FILE
' 4 UNLOCK MESSAGE FILE
' 5 LOCK USER FILE
' 6 LOCK 4 RECORD BLOCK IN USER
' FILE
' 7 UNLOCK USER FILE
' 8 UNLOCK 4 RECORD BLOCK IN USER
' FILE
' 9 LOCK UPLOAD DIRECTORY OR
' COMMENTS FILE
' 10 UNLOCK UPLOAD DIRECTORY OR
' COMMENTS FILE
' ACTIVE.MESSAGE FILE$ NAME OF MESSAGE FILE
' ZActiveUserFile$ NAME OF USER FILE
' CONFIG.FILE.NAME$ FILE NAME TO FLUSH RECORD FROM
' ZWasEN$ UPLOAD DIRECTORY OR COMMENTS
' FILE NAME TO LOCK/UNLOCK
' ZNetworkType TYPE OF NETWORK LOCKING TO USE
'
' OUTPUTS -- ZSubParm = -1 TERMINATE RBBS-PC IMMEDATELY
' ZBlk
' ZLockDrive
' ZLockFileName$
' ZLockStatus$
' ZMsgFileLock
' ZUserBlockLock
' ZUserFileLock
' ZUserFileIndex
'
' PURPOSE -- To lock and unlock the shared RBBS-PC files when
' multiple copies of RBBS-PC are sharing the same
' files in either a multi-tasking DOS environment or
' in a local area network environment
'
SUB FileLock STATIC
ON ZSubParm GOSUB 21995,21996,22000,25000,26000, _
26500,27000,27500,29000,29500
EXIT SUB
'
'
' * UNLOCK USERS AND MESSAGES
'
'
21995 GOSUB 27000
GOSUB 25000
RETURN
'
'
' * FLUSH MESSAGE FILE DATA TO DISK BY OPENING DUMMY FILE # 1
'
'
21996 CLOSE 1
IF ZShareIt THEN _
OPEN ZConfigFileName$ FOR INPUT SHARED AS #1 _
ELSE OPEN "I",1,ZConfigFileName$
'
'
' * UNLOCK MESSAGES
'
'
GOSUB 25000
CALL OpenMsg
RETURN
'
'
' * LOCK MESSAGE FILE
'
'
22000 IF ZMsgFileLock = ZTrue THEN _
RETURN
ZMsgFileLock = ZTrue
MID$(ZLockStatus$,1,2) = "LM"
ZSubParm = 2
CALL Line25
ZLockFileName$ = ZActiveMessageFile$
ON ZNetworkType GOTO 22100,22200,22300,22400,22500,29700
RETURN
'
'
' * LOCK MESSAGE FILE (MULTI-LINK)
'
'
22100 WasAX = &H0
WasBX = &H1
IF ZMultiLinkPresent > 0 THEN _
CALL RBBSML(WasAX,WasBX)
RETURN
'
'
' * LOCK MESSAGE FILE (OMNINET)
'
'
22200 CALL BreakFileName (ZActiveMessageFile$,Drive$,Prefix$,Ext$,ZFalse)
WasCC$ = CHR$(1) + _
LEFT$(Prefix$ + SPACE$(8),8)
GOSUB 28000
IF WasCT = 0 THEN _
RETURN
CALL DelayTime (1)
GOTO 22200
'
'
' * LOCK MESSAGE FILE (ORCHID PC-NET)
' * LOCK USER FILE (ORCHID PC-NET)
' * LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (ORCHID PC-NET)
'
'
22300 GOSUB 28100
CALL LPLKIT(ZLockDrive,ZLockFileName$,ZWasA)
RETURN
'
'
' * LOCK SYSTEM (DESQview)
'
'
22400 CALL DVLock("MESSAGE")
RETURN
'
'
' * LOCK MESSAGE FILE (10 NET)
' * LOCK USER FILE (10 NET)
' * LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (10 NET)
'
'
22500 GOSUB 28100
CALL LPLK10(ZLockDrive,ZLockFileName$,ZWasA)
RETURN
'
'
' * UNLOCK MESSAGE FILE
'
'
25000 IF NOT ZMsgFileLock THEN _
RETURN
ZMsgFileLock = ZFalse
MID$(ZLockStatus$,1,2) = "UM"
ZSubParm = 2
CALL Line25
ZLockFileName$ = ZActiveMessageFile$
ON ZNetworkType GOTO 25100,25200,25300,25400,25500,29800
RETURN
'
'
' * UNLOCK MESSAGE FILE (MULTI-LINK)
'
'
25100 WasAX = &H100
WasBX = &H1
IF ZMultiLinkPresent > 0 THEN _
CALL RBBSML(WasAX,WasBX)
RETURN
'
'
' * UNLOCK MESSAGE FILE (OMNINET)
'
'
25200 CALL BreakFileName (ZActiveMessageFile$,Drive$,Prefix$,Ext$,ZFalse)
WasCC$ = CHR$(17) + _
LEFT$(Prefix$ + SPACE$(8),8)
GOSUB 28000
IF WasCT = 128 THEN _
RETURN
CALL DelayTime (1)
GOTO 25200
'
'
' * UNLOCK MESSAGE FILE (ORCHID PC-NET)
' * UNLOCK USER FILE (ORCHID PC-NET)
' * UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (ORCHID PC-NET)
'
'
25300 GOSUB 28100
CALL UNLOKIT(ZLockDrive,ZLockFileName$,ZWasA)
RETURN
'
'
' * UNLOCK MESSAGE FILE (DESQVIEW)
'
'
25400 CALL DVUnlock("MESSAGE")
RETURN
'
'
' * UNLOCK MESSAGE FILE (10 NET)
' * UNLOCK USER FILE (10 NET)
' * UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (10 NET)
'
'
25500 GOSUB 28100
CALL UNLOK10(ZLockDrive,ZLockFileName$,ZWasA)
RETURN
'
'
' * LOCK USER FILE
'
'
26000 IF ZUserFileLock = ZTrue THEN _
RETURN
ZUserFileLock = ZTrue
MID$(ZLockStatus$,4,2) = "LU"
ZSubParm = 2
CALL Line25
ZLockFileName$ = ZActiveUserFile$
ON ZNetworkType GOTO 26100,26200,22300,26300,22500,29720
RETURN
'
'
' * LOCK USER FILE (MULTI-LINK)
'
'
26100 WasAX = &H0
WasBX = &H2
IF ZMultiLinkPresent > 0 THEN _
CALL RBBSML(WasAX,WasBX)
RETURN
'
'
' * LOCK USER FILE (OMNINET)
'
'
26200 CALL BreakFileName (ZActiveUserFile$,Drive$,Prefix$,Ext$,ZFalse)
WasCC$ = CHR$(1) + _
LEFT$(Prefix$ + SPACE$(8),8)
GOSUB 28000
IF WasCT = 0 THEN _
RETURN
CALL DelayTime (1)
GOTO 26200
'
'
' * LOCK USER FILE (DESQVIEW)
'
'
26300 CALL DVLock("USER")
RETURN
'
'
' * LOCK 4 RECORD BLOCK IN USER FILE
'
'
26500 IF ZUserBlockLock = ZTrue THEN _
RETURN
ZUserBlockLock = ZTrue
ZBlk = (ZUserFileIndex / 4) + .26
MID$(ZLockStatus$,7,2) = "LB"
ZSubParm = 2
CALL Line25
ON ZNetworkType GOTO 26600,26700,26800,26750,26900,29730
RETURN
'
'
' * LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
'
'
26600 WasAX = &H0
WasBX = ZBlk + 10
IF ZMultiLinkPresent > 0 THEN _
CALL RBBSML(WasAX,WasBX)
RETURN
'
'
' * LOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
'
'
26700 WasCC$ = CHR$(1) + _
"BLK" + _
RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
GOSUB 28000
IF WasCT = 0 THEN _
RETURN
CALL DelayTime (1)
GOTO 26700
'
'
' * LOCK 4 RECORD BLOCK IN USER FILE (DESKVIEW)
'
'
26750 CALL DVLock("BLK" + RIGHT$("0000" + MID$(STR$(ZBlk),2),5))
RETURN
'
'
' * LOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
'
'
26800 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
"BLK" + _
RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
GOTO 22300
'
'
' * LOCK 4 RECORD BLOCK IN USER FILE (10 NET)
'
'
26900 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
"BLK" + _
RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
GOTO 22500
'
'
' * UNLOCK USER FILE
'
'
27000 IF NOT ZUserFileLock THEN _
RETURN
ZUserFileLock = ZFalse
MID$(ZLockStatus$,4,2) = "UU"
ZSubParm = 2
CALL Line25
ZLockFileName$ = ZActiveUserFile$
ON ZNetworkType GOTO 27100,27200,25300,27300,25500,29820
RETURN
'
'
' * UNLOCK USER FILE (MULTI-LINK)
'
'
27100 WasAX = &H100
WasBX = &H2
IF ZMultiLinkPresent > 0 THEN _
CALL RBBSML(WasAX,WasBX)
RETURN
'
'
' * UNLOCK USER FILE (OMNINET)
'
'
27200 CALL BreakFileName (ZActiveUserFile$,Drive$,Prefix$,Ext$,ZFalse)
WasCC$ = CHR$(17) + _
LEFT$(Prefix$ + SPACE$(8),8)
GOSUB 28000
IF WasCT = 128 THEN _
RETURN
CALL DelayTime (1)
GOTO 27200
'
'
' * UNLOCK USER FILE (DESQVIEW)
'
'
27300 CALL DVUnlock("USER")
RETURN
'
'
' * UNLOCK 4 RECORD BLOCK IN USER FILE
'
'
27500 IF NOT ZUserBlockLock THEN _
RETURN
ZUserBlockLock = ZFalse
ZBlk = (ZUserFileIndex / 4) + .26
MID$(ZLockStatus$,7,2) = "UB"
ZSubParm = 2
CALL Line25
ON ZNetworkType GOTO 27600,27700,27800,27750,27900,29830
RETURN
'
'
' * UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
'
'
27600 WasAX = &H100
WasBX = ZBlk + 10
IF ZMultiLinkPresent > 0 THEN _
CALL RBBSML(WasAX,WasBX)
RETURN
'
'
' * UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
'
'
27700 WasCC$ = CHR$(17) + _
"BLK" + _
RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
GOSUB 28000
IF WasCT = 128 THEN _
RETURN
CALL DelayTime (1)
GOTO 27700
'
'
' * UNLOCK 4 RECORD BLOCK IN USER FILE (DESQVIEW)
'
'
27750 CALL DVUnlock("BLK" + RIGHT$("0000" + MID$(STR$(ZBlk),2),5))
RETURN
'
'
' * UNLOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
'
'
27800 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
"BLK" + _
RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
GOTO 25300
'
'
' * UNLOCK 4 RECORD BLOCK IN USER FILE (10-NET)
'
'
27900 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
"BLK" + _
RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
GOTO 25500
'
'
' * CORVUS OMNINET INTERFACE
'
'
28000 WasCC$ = ZLineFeed$ + _
CHR$(0) + _
CHR$(11) + _
WasCC$
CALL CDSend(WasCC$)
CALL CDRecv(ZWasCN$)
WasCT = ASC(MID$(ZWasCN$,3,1))
IF WasCT => 128 THEN _
CALL LPrnt("CORVUS LOCK FAIL",1) : _
ZSubParm = -1
28010 WasCT = ASC(MID$(ZWasCN$,4,1))
IF WasCT => 129 THEN _
CALL LPrnt("CORVUS FULL",1) : _
ZSubParm = -1
RETURN
'
'
' * ORCHID PC-NET & 10 NET INTERFACE
'
'
28100 CALL AllCaps (ZLockFileName$)
ZLockDrive = ASC(LEFT$(ZLockFileName$,1)) - ASC("A")
ZLockFileName$ = ZLockFileName$ + _
STRING$(32 - LEN(ZLockFileName$),0)
ZWasA = 0
RETURN
'
'
' * LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$
'
'
29000 IF LockedEn$ = ZWasEN$ THEN _
RETURN
LockedEn$ = ZWasEN$
MID$(ZLockStatus$,10,2) = "LD"
ZSubParm = 2
CALL Line25
ZLockFileName$ = ZWasEN$
ON ZNetworkType GOTO 29100,29010,22300,29300,22500,29710
29010 RETURN
'
'
' * LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (MULTI-LINK)
'
'
29100 WasAX = &H0
WasBX = &H3
IF ZMultiLinkPresent > 0 THEN _
CALL RBBSML(WasAX,WasBX)
RETURN
'
'
' * LOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
'
'
29300 CALL DVLock("MISC")
RETURN
'
'
' * UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$
'
'
29500 IF LockedEn$ <> ZWasEN$ THEN _
RETURN
LockedEn$ = ""
MID$(ZLockStatus$,10,2) = "UD"
ZSubParm = 2
CALL Line25
ZLockFileName$ = ZWasEN$
ON ZNetworkType GOTO 29600,29510,25300,29650,25500,29810
29510 RETURN
'
'
' * UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (MULTI-LINK)
'
'
29600 WasAX = &H100
WasBX = &H3
IF ZMultiLinkPresent > 0 THEN _
CALL RBBSML(WasAX,WasBX)
EXIT SUB
'
'
' * UNLOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
'
'
29650 CALL DVUnlock("MISC")
RETURN
'
'
' * NetBIOS SEMAPHORE LOCK MECHANISM
' * Only the USERS file is actually locked. All other files are locked
' * by means of the semaphore file IBMFLAGS. Each IBMFLAGS record is a
' * file semaphore as follows:
' * RECORD 1 = MESSAGES file lock status
' * RECORD 2 = Comments/Upload dir locked
' * RECORD 3 = entire USERS file lock
'
'
' * Lock MESSAGES
29700 CALL NetBIOS (1,6,1)
RETURN
' * Lock Comments/Upload dir
29710 CALL NetBIOS (1,6,2)
RETURN
' * Lock USERS file
29720 CALL NetBIOS (1,6,3)
RETURN
' * Lock single USERS record
29730 CALL NetBIOS (1,6,3)
RETURN
' * UNLOCK MESSAGES
29800 CALL NetBIOS (0,6,1)
RETURN
' * UNLOCK Comments/Upload dir
29810 CALL NetBIOS (0,6,2)
RETURN
' * UNLOCK USERS file
29820 CALL NetBIOS (0,6,3)
RETURN
' * UNLOCK single USERS record
29830 CALL NetBIOS (0,6,3)
RETURN
END SUB
29898 ' $SUBTITLE: 'NetBIOS - subroutine to lock/unlock using NetBIOS'
' $PAGE
'
' NAME -- NetBIOS (WRITTEN BY DOUG AZZARITO)
'
' INPUTS -- IBMLockCmd = 1-LOCK, 0-UNLOCK
' IBMFileLock = 5 USERS FILE
' = 6 SEMAPHORE FILE
' IBMRecLock = RECORD NUMBER TO LOCK
'
' OUTPUTS -- NONE
'
' PURPOSE -- Lock and unlock files using NetBIOS commands.
' If lock fails, this routine tries forever.
'
SUB NetBIOS (IBMLockCmd,IBMFileLock,IBMRecLock) STATIC
STATIC IBMCount
ON ERROR GOTO 65000
29900 ON IBMLockCmd + 1 GOTO 29920, 29910
EXIT SUB
'
' ***** LOCK LOOP ****
'
29910 ZErrCode = 0
IF IBMFileLock = 6 AND IBMRecLock = 3 THEN _
IBMCount = IBMCount + 1 : _
IF IBMCount > 1 THEN _
EXIT SUB
LOCK IBMFileLock, IBMRecLock TO IBMRecLock
IF ZErrCode <> 0 THEN _
GOTO 29910
EXIT SUB
29920 ZErrCode = 0
IF IBMFileLock = 6 AND IBMRecLock = 3 THEN _
IBMCount = IBMCount - 1 : _
IF IBMCount > 0 THEN _
EXIT SUB _
ELSE IBMCount = 0
UNLOCK IBMFileLock, IBMRecLock TO IBMRecLock
IF ZErrCode <> 0 THEN _
GOTO 29920
END SUB
43048 ' $SUBTITLE: 'UpdateC - update of callers log on exiting'
' $PAGE
'
' NAME -- UpdateC
'
' INPUTS -- PARAMETER MEANING
' ZCallersFileIndex!
' ZFirstName$
' ZWasHHH
' ZLastName$
' ZWasMMM
' ZWasNG$
' ZWasSSS
' ZSysopFirstName$
' ZSysopLastName$
'
' OUTPUTS -- ZCallersRecord$
' ZCallersFileIndex!
' ZSysop
'
' PURPOSE -- Update the callers file at logoff so that the number
' of hours, minutes, and seconds for the session are
' recorded as the last 9 characters of the 64-character
' callers file record
'
SUB UpdateC STATIC
ON ERROR GOTO 65000
IF ZExitToDoors THEN EXIT SUB 'DGS-005
IF ZCallersFilePrefix$ = "" THEN _
EXIT SUB
'
' **** UPDATE CALLERS FILE AT LOGOFF ***
'
43050 FIELD 4,55 AS ZCallersRecord$,3 AS Hours$,3 AS Minutes$,3 AS Seconds$
LSET ZCallersRecord$ = MID$(ZWasNG$,65,55)
LSET Hours$ = STR$(ZSessionHour)
LSET Minutes$ = STR$(ZSessionMin)
LSET Seconds$ = STR$(ZSessionSec)
ZCallersFileIndex! = ZCallersFileIndex! + 1
PUT 4,ZCallersFileIndex!
FIELD 4,64 AS ZCallersRecord$
LSET ZCallersRecord$ = LEFT$(ZWasNG$,64)
ZCallersFileIndex! = ZCallersFileIndex! + 1
PUT 4,ZCallersFileIndex!
43060 LSET ZCallersRecord$ = STRING$(64,CHR$(0))
ZCallersFileIndex! = ZCallersFileIndex! + 1
PUT 4,ZCallersFileIndex!
ZCallersFileIndex! = ZCallersFileIndex! + 1
PUT 4,ZCallersFileIndex!
IF ZOrigCallers$ <> ZCallersFile$ THEN _
ZCallersFile$ = ZOrigCallers$ : _
CALL SetCall : _
GOTO 43050
END SUB
51098 ' $SUBTITLE: 'FindFree - subroutine to find space on a device'
' $PAGE
'
' NAME -- FindFree
'
' INPUTS -- PARAMETER MEANING
' ZWasZ$ NAME OF FILE TO FIND
'
' OUTPUTS -- ZFreeSpace$ NUMBER OF BYTES FREE
'
' PURPOSE -- To determine amount of free space on a device
'
SUB FindFree STATIC
ON ERROR GOTO 65000
ZErrCode = 0
52000 IF ZTurboRBBS THEN _
GOTO 52003
ZFreeSpace$ = ""
CLS
ZErrCode = 0
52001 FILES ZWasZ$
IF ZErrCode = 53 AND (ZWasZ$ = ZCmntsFile$ OR ZWasZ$ = ZUpldDriveFile$ ) THEN _
CALL OpenOutW (ZWasZ$) : _
GOTO 52000
IF ZErrCode = 53 AND ZWasZ$ = ZUpldDir$ THEN _
ZOutTxt$ = "Upload directory missing. Tell SYSOP" : _
ZSubParm = 6 : _
CALL TPut : _
GOTO 52002
FOR WasX = 1 TO 25
ZFreeSpace$ = ZFreeSpace$ + CHR$(SCREEN (3,WasX))
NEXT
52002 ZSubParm = 1
CALL Line25
EXIT SUB
52003 WasAX = 0
WasBX = 0
WasCX = 0
WasDX = 0
IF MID$(ZWasZ$,2,1) = ":" THEN _
WasAX = ASC(ZWasZ$) - ASC("A") + 1
CALL RBBSFree (WasAX,WasBX,WasCX,WasDX)
WasI# = CDBL(WasAX) * (WasBX + 65536! * (-(WasBX < 0))) ' DA050204
WasI# = WasI# * WasCX
ZFreeSpace$ = STR$(WasI#) + _
" bytes free"
END SUB
57978 ' $SUBTITLE: 'OpenWork - subroutine to open RBBS-PC's work file (2)'
' $PAGE
'
' NAME -- OpenWork
'
' INPUTS -- PARAMETER MEANING
' FileNum # OF FILE TO OPEN AS
' FilName$ NAME OF FILE TO FIND
' ZShareIt USE DOS' "SHARE" FACILITIES
'
' OUTPUTS -- ZErrCode ERROR CODE
'
' PURPOSE -- To open RBBS-PC's "work" file (number 2)
'
SUB OpenWork (FileNum,FilName$) STATIC
ON ERROR GOTO 65000
58000 CLOSE FileNum
58010 ZErrCode = 0
58020 IF ZShareIt THEN _
OPEN FilName$ FOR INPUT SHARED AS #FileNum _
ELSE OPEN "I",FileNum,FilName$
IF ZErrCode = 52 THEN _
GOTO 58010
58030 END SUB
58190 ' $SUBTITLE: 'OpenFMS - subroutine to open the FMS directory'
' $PAGE
'
' NAME -- OpenFMS
'
' INPUTS -- PARAMETER MEANING
' ZShareIt DOS SHARING FLAG
' ZFMSDirectory$ NAME OF FMS DIRECTORY
'
' OUTPUTS -- LastRec NUMBER OF THE Last
' RECORD IN THE FILE
'
' PURPOSE -- To open the upload directory as a random file and find
' the number of the last record in the file.
'
SUB OpenFMS (LastRec) STATIC
ON ERROR GOTO 65000
' FileLength = 38 + ZMaxDescLen
FileLength = 32 + ZMaxDescLen ' Bh 082790
CLOSE 2
IF ZActiveFMSDir$ = "" THEN _
IF ZMenuIndex = 6 THEN _
ZActiveFMSDir$ = ZLibDir$ _
ELSE ZActiveFMSDir$ = ZFMSDirectory$
IF ZShareIt THEN _
OPEN ZActiveFMSDir$ FOR RANDOM SHARED AS #2 LEN=FileLength _
ELSE OPEN "R",2,ZActiveFMSDir$,FileLength
' IF ZErrCode > 0 THEN _
' CALL QuickTPut1 ("Drive/path does not exist or bad name for FMS dir " + _
' ZActiveFMSDir$) : _
' END
If ZErrCode > 0 Then 'Pe 02/02/90
ZerrCode = 0
Call QuickTPut1 (CHR$(7) + "Error Has Occured...try again !!! ")
LastRec = 0
EXIT SUB
END IF
LastRec = LOF(2)/FileLength
IF ZActiveFMSDir$ = PrevFMS$ THEN _
EXIT SUB
PrevFMS$ = ZActiveFMSDir$
FIELD 2, FileLength AS FMSRec$
GET #2,1
ZWasA = (LEFT$(FMSRec$,4) <> "\FMS")
ZUpInc = 2*(INSTR(FMSRec$," TOP ") = 0 OR ZWasA) + 1
ZDateOrderedFMS = ZWasA OR (INSTR(FMSRec$," NOSORT") = 0)
ZWasDF = INSTR(FMSRec$,"CH(")
ZChainedDir$ = ""
IF ZWasDF > 0 AND (NOT ZWasA) THEN _
WasX = INSTR(ZWasDF,FMSRec$,")") : _
IF WasX > 0 THEN _
ZChainedDir$ = MID$(FMSRec$,ZWasDF+3,WasX-ZWasDF-3) : _
CALL FindFile (ZChainedDir$,ZOK) : _
IF NOT ZOK THEN _
ZChainedDir$ = ""
END SUB
58220 ' $SUBTITLE: 'OpenOutW - sub to open output work file (2)'
' $PAGE
'
' NAME -- OpenOutW
'
' INPUTS -- PARAMETER MEANING
' ZFileName$ NAME OF FILE TO FIND
' ZShareIt USE DOS' "SHARE" FACILITIES
'
' OUTPUTS -- ZErrCode ERROR CODE
'
' PURPOSE -- To open RBBS-PC's "work" file (number 2) for output
'
SUB OpenOutW (FilName$) STATIC
ON ERROR GOTO 65000
CLOSE 2
58225 ZErrCode = 0
58230 IF ZShareIt THEN _
OPEN FilName$ FOR OUTPUT SHARED AS #2 _
ELSE OPEN "O",2,FilName$
58235 END SUB
58260 ' $SUBTITLE: 'KillWork - subroutine to delete a "work" file'
' $PAGE
'
' NAME -- KillWork
'
' INPUTS -- PARAMETER MEANING
' FilName$ NAME OF FILE TO DELETE
'
' OUTPUTS -- ZErrCode ERROR CODE
'
' SUBROUTINE PURPOSE -- To delete a RBBS-PC "work" file
'
SUB KillWork (FilName$) STATIC
ON ERROR GOTO 65000
CLOSE 2
ZErrCode = 0
58270 KILL FilName$
58275 END SUB
58280 ' $SUBTITLE: 'GetPassword - sub to read the "passwords" file'
' $PAGE
'
' NAME -- GetPassword
'
' PARAMETER MEANING
' INPUTS -- FILE # 2 OPENED
'
' OUTPUTS -- ZTempPassword$
' ZTempSecLevel
' ZTempTimeAllowed
' ZTempRegPeriod
' ZTempMaxPerDay
'
' PURPOSE -- To read the RBBS-PC "PASSWORDS" file
'
SUB GetPassword STATIC
ON ERROR GOTO 65000
ZErrCode = 0
INPUT #2,ZTempPassword$, ZTempSecLevel, _
ZTempTimeAllowed, ZTempMaxPerDay, _
ZTempRegPeriod, ZStartTime, _
ZEndTime, ZByteMethod, _
ZRatioRestrict#, ZInitialCredit#, _
ZTempTimeLock
58285 END SUB
58290 ' $SUBTITLE: 'ReadDir - subroutine to read the "DIR" files'
' $PAGE
'
' NAME -- ReadDir
'
' PARAMETER MEANING
' INPUTS -- FileNum WHICH # FILE TO READ
' WhichLine HOW MANY LINES TO ADVANCE
'
' OUTPUTS -- ZOutTxt$
'
' PURPOSE -- To read possible "DIR" files
'
SUB ReadDir (FileNum,WhichLine) STATIC
ON ERROR GOTO 65000
ZErrCode = 0
FOR WasI = 1 TO WhichLine
LINE INPUT #FileNum,ZOutTxt$
NEXT
58295 END SUB
58300 ' $SUBTITLE: 'ReadParms - subroutine to read parameter values'
' $PAGE
'
' NAME -- ReadParms
'
' PARAMETER MEANING
' INPUTS -- FILE # 2 OPENED
' NumParms # parameters to read
' WhichLine Which set of parms to return
' OUTPUTS -- ARA.TO.USER$ Array of string values
' FILE.SECURITY
' FilePswd$
'
' PURPOSE -- To read different values, where values are
' separated by a comma or carriage-return-line-feed.
'
SUB ReadParms (AraToUse$(1),NumParms,WhichLine) STATIC
ON ERROR GOTO 65000
ZErrCode = 0
FOR WasJ = 1 TO WhichLine
FOR WasI = 1 TO NumParms
INPUT #2,AraToUse$(WasI)
NEXT
NEXT
58305 END SUB
58310 ' $SUBTITLE: 'ReadAny - subroutine to read file 2 into ZOutTxt$'
' $PAGE
'
' NAME -- ReadAny
'
' PARAMETER MEANING
' INPUTS -- FILE # 2 OPENED
'
' OUTPUTS -- ZOutTxt$
'
' PURPOSE -- To read file #2 into ZOutTxt$
'
SUB ReadAny STATIC
ON ERROR GOTO 65000
ZErrCode = 0
INPUT #2,ZOutTxt$
58315 END SUB
58320 ' $SUBTITLE: 'PrintWork - subroutine to print to file 2'
' $PAGE
'
' NAME -- PrintWork
'
' PARAMETER MEANING
' INPUTS -- FILE # 2 OPENED
' STRING TO WRITE OUT
'
' OUTPUTS -- NONE
'
' PURPOSE -- To print a string to file #2
'
SUB PrintWork (Strng$) STATIC
ON ERROR GOTO 65000
ZErrCode = 0
PRINT #2,Strng$;
58325 END SUB
58330 ' $SUBTITLE: 'GetWork - subroutine to read file 2'
' $PAGE
'
' NAME -- GetWork
'
' PARAMETER MEANING
' INPUTS -- RecLen Length of record
'
' OUTPUTS -- NONE
'
' PURPOSE -- To read a record from file #2
'
SUB GetWork (RecLen) STATIC
ON ERROR GOTO 65000
ZErrCode = 0
FIELD 2, RecLen AS ZDnldRecord$
GET 2,(LOC(2)+1)
58335 END SUB
58340 ' $SUBTITLE: 'OpenWorkA - subroutine to open output work file (2)'
' $PAGE
'
' NAME -- OpenWorkA
'
' INPUTS -- PARAMETER MEANING
' FilName$ NAME OF FILE TO FIND
' ZShareIt USE DOS' "SHARE" FACILITIES
'
' OUTPUTS -- ZErrCode ERROR CODE
'
' PURPOSE -- To open RBBS-PC's "work" file (number 2) for appended output
'
SUB OpenWorkA (FilName$) STATIC
ON ERROR GOTO 65000
CLOSE 2
ZErrCode = 0
IF ZShareIt THEN _
OPEN FilName$ FOR APPEND SHARED AS #2 _
ELSE OPEN "A",2,FilName$
58345 END SUB
58350 ' $SUBTITLE: 'PrintWorkA - subroutine to print to file 2 with CR'
' $PAGE
'
' NAME -- PrintWorkA
'
' PARAMETER MEANING
' INPUTS -- FILE # 2 OPENED
' STRING TO WRITE OUT
'
' OUTPUTS -- NONE
'
' PURPOSE -- To print a string to file #2 followed by a carriage return
'
SUB PrintWorkA (Strng$) STATIC
ON ERROR GOTO 65000
ZErrCode = 0
PRINT #2,Strng$
58355 END SUB
58360 ' $SUBTITLE: 'CheckInt - subroutine to check input is an integer'
' $PAGE
'
' NAME -- CheckInt
'
' PARAMETER MEANING
' INPUTS -- Strng$ STRING TO VERIFY CAN BE AN INTEGER
'
' OUTPUTS -- ZErrCode = 0 MEANS IT IS AN INTEGER VALUE
' <> 0 MEANS IT IS NOT AN INTEGER VALUE
' ZTestedIntValue Integer value of expression ' KG083102
'
' PURPOSE -- To validate that a string represents an integer
'
SUB CheckInt (Strng$) STATIC
ON ERROR GOTO 65000
ZErrCode = 0
WasX$ = Strng$ ' KG083102
CALL Trim (WasX$) ' KG083102
ZTestedIntValue = VAL(LEFT$(WasX$,INSTR(WasX$+" "," ")-1)) ' KG083102
58365 END SUB
59650 ' $SUBTITLE: 'PutCom -- subroutine to write to communications port'
' $PAGE
'
' NAME -- PutCom
'
' INPUTS -- PARAMETER MEANING
' Strng$ STRING TO PRINT TO COMM PORT
' ZFlowControl WHETHER USING CLEAR TO SEND FOR FLOW
' CONTROL BETWEEN THE PC AND THE MODEM
'
' OUTPUTS --
'
' PURPOSE -- Checks for carrier drop and flow control (xon/xoff)
' before writing to the communications port.
'
SUB PutCom (Strng$) STATIC
ON ERROR GOTO 65000
IF ZLocalUser THEN _
EXIT SUB
CALL CheckCarrier ' KG061203
IF ZSubParm = -1 THEN _
EXIT SUB
IF NOT ZXOffEd THEN _
GOTO 59652
ZSubParm = 1
CALL Line25
ZWasY$ = ZXOff$
XOffTimeout! = TIMER + ZWaitBeforeDisconnect ' DA110304
WHILE ZWasY$ = ZXOff$ AND ZSubParm <> -1
Char = -1
WHILE Char = -1 AND ZSubParm <> -1
GOSUB 59654
WEND
IF Char <> -1 THEN _
CALL GetCom(ZWasY$) : _
IF ZXOnXOff AND ZWasY$ <> ZXOn$ THEN _
ZWasY$ = ZXOff$
WEND
ZXOffEd = ZFalse
ZSubParm = 1
CALL Line25
59652 ZNotCTS = ZFalse
PRINT #3,Strng$;
EXIT SUB
59653
59654 CALL EofComm (Char)
CALL GoIdle
CALL CheckCarrier ' KG061203
CALL CheckTime(XOffTimeout!, TempElapsed!,1) ' DA110302
IF ZSubParm = 2 THEN _ ' DA110302
ZSubParm = -1 ' DA110302
RETURN
END SUB
59660 ' $SUBTITLE: 'PutWork -- subroutine to write to upload files'
' $PAGE
'
' NAME -- PutWork
'
' INPUTS -- PARAMETER MEANING
' STNG$ STRING TO WRITE TO FILE
' RecNum RECORD NUMBER TO WRITE
' RecLen LENGTH OF RECORD TO WRITE
'
' OUTPUTS --
'
' PURPOSE -- Writes uploaded file records to work file
'
SUB PutWork (Strng$,RecNum,RecLen) STATIC
ON ERROR GOTO 65000
FIELD #2,RecLen AS ZUpldRec$
LSET ZUpldRec$ = Strng$
RecNum = RecNum + 1
PUT #2,RecNum
END SUB
'
'********************************************************************
' THREAD1 First message thread routine *
' THREAD2 Second message thread routine *
' THREAD3 Third message thread routine *
'********************************************************************
'===========================================================================
59670 ' $SUBTITLE: 'Thread1 - create/update threaded message file'
' $PAGE
'
' SUBROUTINE NAME -- THREAD1
'
' INPUT PARAMETERS -- PARAMETER MEANING
' HighMsgNumber This reply's message number
' CurMsg Message number being replied
'
' OUTPut PARAMETERS -- <<NONE>>
'
' SUBROUTINE PURPOSE -- SUBROUTINE TO...
'
SUB Thread1 (HighMsgNumber,CurMsg,ZConfName$) STATIC
CALL BreakFileName (ZMainMsgFile$,Drive$,Prefix$,Ext$,ZTrue) 'Pe 08/02/89
IF INSTR(ZConfName$," ") = 0 THEN 'PE102587
ZFileName$ = Drive$ +ZConfName$ + "T" 'PE08/02/89
ELSE
ZFileName$ = Drive$ +LEFT$(ZConfName$,INSTR(ZConfName$," ")-1)+"T" 'PE 08/02/89
END IF
CurMsg$ = STR$(CurMsg)
HighMsgNumber$ = STR$(HighMsgNumber)
OPEN "R",9,ZFileName$,12
FIELD 9, 6 AS CM$, 6 AS HMN$
LSET CM$ = CurMsg$
LSET HMN$ = HighMsgNumber$
PUT #9,INT(LOF(9)/12)+1
CLOSE (9)
END SUB ' THREAD1
'
59671 ' $SUBTITLE: 'Thread2 - a message was killed - check threaded message file'
' $PAGE
'
' SUBROUTINE NAME -- THREAD2
'
' INPUT PARAMETERS -- PARAMETER MEANING
' MsgToKill Killed message's number
'
' OUTPut PARAMETERS -- <<NONE>>
'
' SUBROUTINE PURPOSE -- SUBROUTINE TO ...
'
SUB Thread2 (MsgToKill,ActiveMessages,ZConfName$) STATIC
CALL BreakFileName (ZMainMsgFile$,Drive$,Prefix$,Ext$,ZTrue) 'Pe 08/02/89
IF INSTR(ZConfName$," ") = 0 THEN 'PE102587
ZFileName$ = Drive$ +ZConfName$ + "T" 'Pe 08/02/89
ELSE
ZFileName$ = Drive$+LEFT$(ZConfName$,INSTR(ZConfName$," ")-1)+"T" 'Pe 08/02/89
END IF
OPEN "R",9,ZFileName$,12
FIELD 9, 6 AS CM$, 6 AS HMN$
FOR I = 1 TO INT(LOF(9)/12)
GET 9,I
IF VAL(CM$) = MsgToKill THEN ' MARK THE RECORD
LSET CM$ = LEFT$(CM$,5) + "K"
PUT 9,I
ELSE
IF VAL(HMN$) = MsgToKill THEN ' MARK THE RECORD
LSET HMN$ = LEFT$(HMN$,5) + "K"
LSET CM$ = LEFT$(CM$,5) + "K"
PUT 9,I
END IF
END IF
NEXT I
CLOSE (9)
END SUB ' THREAD2
'
59672 ' $SUBTITLE: 'THREAD3 - a message was killed - check threaded message file'
' $PAGE
'
' SUBROUTINE NAME -- THREAD3
'
' INPUT PARAMETERS -- PARAMETER MEANING
' CurMsg Message's number
'
' OUTPut PARAMETERS -- <<NONE>>
'
' SUBROUTINE PURPOSE -- SUBROUTINE TO ...
'
SUB THREAD3 (CurMsg,ZConfName$) STATIC
IF ZJustSearching THEN _ 'PE 02/05/90
EXIT SUB 'PE 01/16/89
CALL BreakFileName (ZMainMsgFile$,Drive$,Prefix$,Ext$,ZTrue) 'Pe 08/02/89
IF INSTR(ZConfName$," ") = 0 THEN
ZFileName$ = Drive$ +ZConfName$ + "T" 'pe 08/02/89
ELSE
ZFileName$ = Drive$ + LEFT$(ZConfName$,INSTR(ZConfName$," ")-1)+"T" 'Pe 08/02/89
END IF
OPEN "R",9,ZFileName$,12
FIELD 9, 6 AS CM$, 6 AS HMN$
AA$ = ""
ZZ$ = ""
FOR I = 1 TO INT(LOF(9)/12)
GET 9,I
IF RIGHT$(HMN$,1) = "K" THEN 59673
IF VAL(CM$) = CurMsg AND RIGHT$(HMN$,1) <> "K" THEN
AA$ = AA$ + HMN$
END IF
IF VAL(HMN$) = CurMsg AND RIGHT$(CM$,1) = "K" THEN
ZZ$ = LEFT$(CM$,5) + ZFG1$+"(deleted) "+ZEmphasizeOff$
END IF
IF VAL(HMN$) = CurMsg AND RIGHT$(CM$,1) <> "K" THEN
ZZ$ = CM$
END IF
59673 NEXT I
IF LEN(AA$) > 0 THEN
CALL QuickTPut(ZFG3$+" Reply(ies) in message number(s): "+ZFG1$ + AA$+ZEmphasizeOff$,1)
END IF
IF LEN(ZZ$) > 0 THEN
CALL QuickTPut (ZFG4$+" This message is in reply to message " +ZFG1$+ ZZ$+ZEmphasizeOff$,1)
END IF
CALL QuickTPut (ZFG2$+ "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"+ZEmphasizeOff$,1)
CLOSE (9)
END SUB ' THREAD3
'
59674 ' $SUBTITLE: 'Thread4 - UPDATE CONFR.DEF FILE FOR MESSAGE RECOVERY'
' $PAGE
'
' SUBROUTINE NAME -- THREAD4
'
' INPUT PARAMETERS -- PARAMETER MEANING
'
' MsgToRecover MESSAGE NumBER BEING RECOVERED
' FirstMsgRecord NOT USED HERE BUT PASSED IN
' FROM RBBS CALL TO SUB2
' ActionFlag PASSED FROM SUB2 NEEDED TO
' GIVE BACK TO RBBS MAIN CODE
' ZConfName$ CONFERENCE NAME
'
' OUTPut PARAMETERS -- <<NONE>>
'
' SUBROUTINE PURPOSE -- SUBROUTINE - UPDATE CONFR.DEF FILE AFTER MSG RECVRY
'
SUB Thread4 (MsgToRecover,FirstMsgRecord,ActionFlag,ZConfName$) STATIC
CALL BreakFileName (ZMainMsgFile$,Drive$,Prefix$,EXT$,ZTrue) 'Pe 08/02/89
IF INSTR(ZConfName$," ") = 0 THEN
ZFileName$ = Drive$ + ZConfName$ + "T" 'Pe 08/02/89
ELSE
ZFileName$ = Drive$ + LEFT$(ZConfName$,INSTR(ZConfName$," ")-1)+"T" 'Pe 08/02/89
END IF
OPEN "R",9,ZFileName$,12 'WILL CREATE FILE IF NOT EXIST
FIELD 9, 6 AS CM$, 6 AS HMN$
FOR I = 1 TO INT(LOF(9)/12)
GET 9,I
IF VAL(CM$) = MsgToRecover THEN
LSET CM$ = LEFT$(CM$,5) + " "
PUT 9,I
ELSE
IF VAL(HMN$) = MsgToRecover THEN
LSET HMN$ = LEFT$(HMN$,5) + " "
LSET CM$ = LEFT$(CM$,5) + " "
PUT 9,I
END IF
END IF
NEXT I
CLOSE (9)
END SUB 'THREAD4
59725 ' $SUBTITLE: 'CommPut -- Writes to communications port'
' $PAGE
'
' NAME -- CommPut
'
' INPUTS -- PARAMETER MEANING
' Strng$ String to write
' ZFossil Whether using Fossil driver
'
' OUTPUTS --
'
' PURPOSE -- Send string to comm port. Recovers from errors.
'
SUB CommPut (Strng$) STATIC
ON ERROR GOTO 65000
PRINT #3,Strng$;
END SUB
'59750' $SUBTITLE: 'DGSAlias - Subroutine to Create/Update Alias Info file'
' $PAGE
'
' SUBROUTINE NAME -- DGSAlias
'
' INPUT PARAMETERS -- PARAMETER MEANING
' ZConfName$ CONFERENCE NAME
' ZOrigUserNameDGS$ USERS - LOG ON NAME
' DGSAlias$ USERS - ALIAS NAME
' DGSStl$ NULL FIRST TIME IN
' 'STILL' IF ALIAS EXISTS
' OR REAL NAME
' DGSFileName$ CONFERENCE ALIAS FILE
'
' OUTPUT PARAMETERS -- ZConfName$ ZOrigUserNameDGS$ DGSAlias$ DGSStl$
' DGSFileName$
'
' SUBROUTINE PURPOSE -- TO Read ConfA.DEF and Get Users ALIAS or
' Create One
'
' SUB DGSAlias (ZConfName$,ZOrigUserNameDGS$,DGSAlias$,DGSStl$,DGSFileName$) STATIC
'
' IF DGSStl$ = "" THEN
' ConfADefFlag = 0
' CALL BreakFileName (ZMainUserFile$,Drive$,Prefix$,Ext$,ZTrue)
' DGSFileName$ = Drive$ + ZConfName$ + "A.DEF"
' CALL FindIt (DGSFileName$)
' IF ZOK THEN
' ConfADefFlag = ZTrue
' END IF
' IF ConfADefFlag = ZTrue THEN
' OPEN "I", 7, DGSFileName$
' DGSAlias$ = ""
' WHILE DGSAlias$ = "" AND NOT EOF(7)
' INPUT #7, DGSUserName$, DGSTempAlias$
' DGSUnl = LEN(DGSUserName$)
' IF DGSUserName$ = LEFT$(ZOrigUserNameDGS$,DGSUnl) THEN
' DGSAlias$ = DGSTempAlias$
' END IF
' WEND
' CLOSE 7
' ELSE
' DGSAlias$ = "NO CONFA.DEF"
' EXIT SUB
' END IF
' END IF
' CALL GoodAls (ZConfName$,ZOrigUserNameDGS$,DGSAlias$,DGSStl$,DGSFileName$)
' END SUB
'
'
' $SUBTITLE: 'GoodAls - Subroutine to Make Sure Alias Good'
' $PAGE
'
' SUBROUTINE NAME -- GoodAls
'
' INPUT PARAMETERS -- PARAMETER MEANING
' ZConfName$ CONFERENCE NAME
' ZOrigUserNameDGS$ USERS - LOG ON NAME
' DGSAlias$ USERS - ALIAS NAME
' DGSStl$ NULL FIRST TIME IN
' 'STILL' IF ALIAS EXISTS
' OR REAL NAME
' DGSFileName$ CONFERENCE ALIAS FILE
'
' OUTPUT PARAMETERS -- ZConfName$ ZOrigUserNameDGS$ DGSAlias$ DGSStl$
' DGSFileName$
'
' SUBROUTINE PURPOSE -- To Read ConfA.DEF and see if Users ALIAS is
' Aready in Use or a Real Name
'
' SUB GoodAls (ZConfName$,ZOrigUserNameDGS$,DGSAlias$,DGSStl$,DGSFileName$) STATIC
'
' IF DGSAlias$ = "" THEN
' DGSSfnSln$ = ZSysopFirstName$+" "+ZSysopLastName$
' ZOutTxt$ = "Do you" +DGSStl$+ " want to use an Alias? (Y,[N])"
' ZSubParm = 1
' CALL TGet
' IF ZYes THEN
' ABFlg$ = ""
' ZOutTxt$ = "Enter Alias (31 Char. Max.) "
' ZSubParm = 1
' CALL TGet
' CALL AllCaps (ZUserIn$)
' IF ZUserIn$ = "" OR INSTR(SPACE$(31),ZUserIn$) > 0 THEN
' ZUserIn$ = ""
' ABFlg$ = "Alias Must NOT be Blank"
' END IF
' IF LEN(ZUserIn$) > 31 THEN
' ZUserIn$= ""
' ABFlg$ = "Length Must NOT Exceed 31 Characters"
' END IF
' IF ZUserIn$ = "SYSOP" OR ZUserIn$ = DGSSfnSln$ THEN
' ZOutTxt$ = CHR$(7)+CHR$(7)
' ZOutTxt$ = ZOutTxt$ + "Wrong Answer! Alias Request Denied!"
' ZOutTxt$ = ZOutTxt$ + CHR$(13) + "Contact Sysop for Alias Retry"
' CALL QuickTPut (ZOutTxt$,2)
' DGSAlias$ = ZOrigUserNameDGS$+CHR$(250)
' ZActiveUserName$ = ZOrigUserNameDGS$+CHR$(250)
' ZFirstName$ = ZOrigUserNameDGS$+CHR$(250)
' ELSE
' OPEN "I", 7, DGSFileName$
' WHILE ABFlg$ = "" AND NOT EOF(7)
' INPUT #7, DGSUserName$, DGSTempAlias$
' IF ZUserIn$ = DGSUserName$ THEN
' ABFlg$ = " is a Real User"
' ELSE
' IF ZUserIn$ = DGSTempAlias$ THEN
' ABFlg$ = " has Already been Used"
' END IF
' END IF
' WEND
' CLOSE 7
' IF ABFlg$="" THEN
' DGSAlias$ = ZUserIn$
' ZActiveUserName$ = ZUserIn$
' ZFirstName$ = ZUserIn$
' ELSE
' ZOutTxt$="Sorry "+ZFirstName$+" but "+ZUserIn$+ABFlg$
' CALL QuickTPut (ZOutTxt$,1)
' DGSStl$ = " still"
' DGSAlias$ = ""
' END IF
' END IF
' ELSE
' DGSAlias$ = ZOrigUserNameDGS$
' END IF
' IF DGSAlias$ <> "" THEN
' CLOSE 2
' FOR I = 1 TO LEN(DGSAlias$)
' IF MID$(DGSAlias$,I,1)=CHR$(34) THEN MID$(DGSAlias$,I,1)=CHR$(39)
' NEXT I
' OPEN "A", 2, DGSFileName$
' WRITE #2, ZOrigUserNameDGS$, DGSAlias$
' CLOSE 2
' END IF
' ELSE
' ZActiveUserName$ = DGSAlias$
' ZFirstName$ = DGSAlias$
' END IF
' END SUB
59790 ' $SUBTITLE: 'FindFile -- subroutine to find a file' ' AC012601
' $PAGE
'
' NAME -- FindFile
'
' INPUTS -- PARAMETER MENANING
' FilName$ NAME OF FILE TO LOOK FOR
' FExists WHETHER FILE EXISTS
'
' OUTPUTS -- RETURNED.VALUE VALUE RETURNED
' TRUE = FILE EXISTS
' TRUE = FILE DOES NOT EXIST
'
' PURPOSE -- Determine whether passed file FilName$ exists
' Unlike, FindIt, this routine does not open any
' file and, hence, does not create one in determining
' whether a file exists.
'
SUB FindFile (FilName$,FExists) STATIC ' AC012601
CALL BadFileChar (FilName$,FExists) ' AC012601
59791 IF FExists THEN _ ' KG012802
IOErrorCount = 0 : _ ' AC012601
CALL RBBSFind (FilName$,WasZ,WasY,WasM,WasD) : _ ' KG012601
FExists = (WasZ = 0) ' AC012601
END SUB ' AC012601
'
' ** OPEN RBBSCHAT.DEF AS #7
'
'59800 SUB OpenWrk7(ChatFileName$) STATIC
' ON ERROR GOTO 65000
' IF ZShareIt THEN
' OPEN ChatFileName$ FOR RANDOM ACCESS READ WRITE SHARED AS #7 LEN = 128
' ELSE
' OPEN ChatFileName$ FOR RANDOM AS #7 LEN = 128
' END IF
' END SUB
'
' ** DO ALL THE RBBSCHAT.DEF GET's AND PUT's HERE **
'
'59810 SUB LockIt7(Record, ReadIt) STATIC
' ON ERROR GOTO 65000
' IF ReadIt THEN
' GET 7, Record
' ELSE
' IF ZShareIt THEN
' LOCK 7, Record
' END IF
' PUT 7, Record
' IF ZShareIt THEN
' UNLOCK 7, Record
' END IF
' END IF
' END SUB
'
' $SUBTITLE: 'ViewTxt - Subroutine to display ASCII file from ARC file'
' $PAGE
'
SUB Viewtxt STATIC
ON ERROR GOTO 65000
'
60140 ZSubParm = 1
ZOutTxt$ ="T)ype to Screen, X)tract, C)ompress, D)ir, H)elp or [RETURN] to Quit" ' Bh
ZTurboKey = -ZTurboKeyUser
CALL TGet 'Pe 02/12/90
IF ZSubParm = -1 or ZWasQ = 0 THEN _ 'Pe 02/04/90
EXIT SUB 'Pe 05/24/89
CALL AllCaps (ZUserIn$)
MplX = INSTR("TXCD?HQ",ZUserIn$)
ON MplX GOTO 60149,60168,60175,60142,60141,60141,60180
GOTO 60180
'
60141 CALL BufFile (ZHelpPath$ + "ZIP" + ZHelpExtension$,WasX) 'Pe 03/26/89
GOTO 60140 'Pe 03/26/89
60142 CALL QuickTPut ("Creating file list, one moment please....",1)
EXTRACT$ = "DIR "+ ZArkViewPath$+"*.* >VUZIP"+ZNodeID$+".LST" 'Pe 01/24/90
SHELL EXTRACT$
CALL BufFile("VUZIP"+ZNodeID$ +".LST",WasX)
GOTO 60140
'
60149 ZSubParm = 1
ZOutTxt$ = "Which file(s) should I display, R)elist or [RETURN] to quit" 'DMOD1 ' Bh
CALL TGet
IF ZSubParm = -1 THEN _
EXIT SUB 'Pe 05/24/89
ZWasB = 1 'DMOD1
IF ZWasQ = 0 THEN _ 'DMOD1
GOTO 60140 'Pe 05/24/89 was Exit Sub
IF ZUserIn$ = "R" or ZUserIn$ = "r" THEN _
CALL BufFile (ZArcWork$,WasX) : _
GOTO 60149
LastArc = ZWasQ 'DMOD1
FirstArc =ZWasB 'DMOD1
'
FOR ArcIndex = FirstArc TO LastArc 'DMOD1
WasZ$ = ZUserIn$(ArcIndex) 'DMOD1
CALL AllCaps (WasZ$)
IF INSTR(WasZ$,"*") OR INSTR(WasZ$,"?") THEN _
CALL QuickTPut ("Sorry, but Wildcards are NOT allowed !!",1) : _ ' Bh
GOTO 60149 'PEMOD1
CALL BreakFileName (WasZ$,Drive$,Prefix$,Ext$,ZFalse) 'DMOD1
IF Ext$ = "ARC" OR Ext$ = "COM" OR Ext$ = "EXE" OR Ext$ = "BAS" OR _ 'DMOD1
Ext$ = "BIN" OR Ext$ = "LIB" OR Ext$ = "OBJ" OR Ext$ = "PIC" THEN _
CALL QuickTPut ("Sorry, but only text files can be displayed",1) :_ 'DMOD1 ' Bh
GOTO 60149 'DMOD1
CALL QuickTPut (" Extracting file....",1) 'DMOD1
'
'
' ******* Next 3 lines added for ZIP support Pe 02/19/89
IF ZLastExt$ = "ZIP" THEN _
SHOWME$ = ZLibArcPath$+"PKUNZIP -O " + ZFileName$ + " " + WasZ$ + " "+ZArkViewPath$ : _
GOTO 60150 _
ELSE IF ZLastExt$ = "LZH" THEN _
SHOWME$ = ZLibArcPath$+"VIEWLZH.BAT "+ZArkViewPath$+" "+ZFileName$+" "+WasZ$ : _
GOTO 60150
'
IF MID$(ZLibArcProgram$,1,2) ="PK" THEN _
SHOWME$ = ZLibArcPath$+"PKXARC -R " + ZFileName$ + " " + WasZ$ + " "+ZArkViewPath$
IF MID$(ZLibArcProgram$,1,2) ="AR" THEN _
SHOWME$ = ZLibArcPath$+"ARCE " + ZFileName$ + " " + WasZ$ + " "+ZArkViewPath$ + " /R"
IF MID$(ZLibArcProgram$,1,3) ="PAK" THEN _
SHOWME$ = ZLibArcPath$+"PAK /E /WA " + ZFileName$ + " "+ ZArkViewPath$+WasZ$
60150 SHOWME$ = "COMMAND.COM /C "+SHOWME$ 'Pe 09/20/89
SHELL SHOWME$ 'Pe 02/19/89
WasZ$ = ZArkViewPath$ + WasZ$ 'Pe 09/23/89
Temp$ = WasZ$
CALL FindIt (WasZ$)
IF NOT ZOK THEN _
CALL QuickTPut(CHR$(7)+WasZ$+" ISN'T HERE or perhaps you misspelled",1) :_ ' Bh
GOTO 60149
CALL BufFile (WasZ$,WasX) 'DMOD1
CALL KillWork(Temp$) 'get rid of the files that were xtracted PEMOD1
NEXT ArcIndex
GOTO 60140
'
60168 ZSubParm = 1
CALL SkipLine (1)
60169 ZOutTxt$ = "Which file(s) to Extract, R)elist or [RETURN] to quit" ' Bh
CALL TGet
IF ZSubParm = -1 OR ZWasQ = 0 THEN _ 'Pe 02/12/90
EXIT SUB 'Pe 02/12/90
IF ZUserIn$ = "R" or ZUserIn$ = "r" THEN _
CALL BufFile (ZArcWork$,WasX) : _
GOTO 60168
ZwasB = 1 'DMOD1
LastArc = ZwasQ 'DMOD1
FirstArc = ZwasB 'DMOD1
FOR ArcIndex = FirstArc TO LastArc 'DMOD1
WasZ$ = ZUserIn$(ArcIndex) 'DMOD1
CALL AllCaps (WasZ$)
CALL BreakFileName (WasZ$,Drive$,Prefix$,Ext$,ZFalse) 'DMOD1
CALL SkipLine (2)
CALL QuickTPut ("Please stand by, extracting file(s)....",1) 'DMOD1
'
'Next 3 lines for ZIP Support Pe 02/19/89
'
IF ZLastExt$ = "ZIP" THEN _
SHOWME$ = ZLibArcPath$+"PKUNZIP -O " + ZFileName$ + " " + WasZ$ + " "+ZArkViewPath$ : _
GOTO 60170 _
ELSE IF ZLastExt$ = "LZH" THEN _
SHOWME$ = ZLibArcPath$+ "VIEWLZH.BAT "+ZArkViewPath$+" "+ZFileName$+" "+WasZ$ : _
GOTO 60170
'
'
IF MID$(ZLibArcProgram$,1,2) ="PK" THEN _
SHOWME$ = ZLibArcPath$+"PKXARC -R " + ZFileName$ + " " + WasZ$ + " " + ZArkViewPath$
IF MID$(ZLibArcProgram$,1,2) ="AR" THEN _
SHOWME$ = ZLibArcPath$+"ARCE " + ZFileName$ + " " + WasZ$ + " " + ZArkViewPath$+" /R"
IF MID$(ZLibArcProgram$,1,3) ="PAK" THEN _
SHOWME$ = ZLibArcPath$+"PAK /E /WA " + ZFileName$ + " " + ZArkViewPath$ + "\" +WasZ$
'
60170 SHOWME$ = "COMMAND.COM /C "+ SHOWME$
SHELL SHOWME$ 'Added line Number Pe 02/19/89
LOOKFOR$ = ZArkViewPath$ + WasZ$ 'Pe 09/23/89
CALL FindIt(LOOKFOR$)
IF NOT ZOK THEN _
CALL QuickTPut ("Error extracting " + WasZ$ + "...file Skipped...",2) : _
GOTO 60171
CALL QuickTPut (WasZ$+" Is now Extracted ...",2)
60171 NEXT ArcIndex
CALL QuickTPut ("Use the C)ompress command to create a ZIP file of Xtracted files",2)
GOTO 60140
'
' *** Added choice of Compressing file or taking it as is Pe 03/23/89 ***
'
60175 ZSubparm = 1 'Pe 02/12/90
ZOutTxt$ = ZCrLf$ +"List files about to be Compressed (Y/[N])"
ZTurboKey = -ZTurboKeyUser 'Pe 02/12/90
CALL TGet
CALL AllCaps (ZUserIn$) 'Pe 02/12/90
IF ZSubParm = -1 THEN _ 'Pe 03/29/88
EXIT SUB 'Pe 03/29/88
IF ZWasQ = 0 OR ZUserIn$ ="N" Then _ 'Pe 02/12/90
GOTO 60179 'pe 04/07/89
IF ZUserIn$ = "Y" THEN _ 'Pe 03/29/89
CALL QuickTPut ("Creating file list, one moment please....",1): _
EXTRACT$ = "DIR "+ ZArkViewPath$+"*.* >VUZIP"+ZNodeID$+".LST" : _
SHELL EXTRACT$ : _
CALL BufFile("VUZIP"+ZNodeID$ +".LST",WasX) : _
ZSubParm = 1 : _ 'Pe 03/26/89
ZOutTxt$ = ZCrLf$ +"Continue with file Compression ([Y]/N) " : _
ZTurboKey = -ZTurboKeyUser : _ 'Pe 02/12/90
CALL TGet : _
IF ZSubParm = -1 THEN _ 'Pe 03/29/88
EXIT SUB : _ 'Pe 03/29/88
IF ZUserIn$ = "N" or ZUserIn$ = "n" THEN _ 'Pe 03/29/89
GOTO 60140 : _
CALL QuickTPut ("One Moment Compressing file(s)........",1)
'
'********** ZIP all files in the ZArkViewPath$ into VIEW.ZIP **********
'
'60179 ZIPME$ = ZLibArcPath$+"PKZIP -m -ex -z<C:\C3\MPL.CMT " + ZArkViewPath$ + "VIEW.ZIP " + ZArkViewPath$ + "*.*"
60179 ZIPME$ = ZLibArcPath$+"PKZIP -m -ex " + ZArkViewPath$ + "VIEW.ZIP " + ZArkViewPath$ + "*.*"
'
If ZLocalUser THEN _
SHELL ZIPME$ _
ELSE ZIP$ = "VUZIP"+ZNodeID$+".BAT": _
CALL OpenOutW (ZIP$) : _
PRINT #2, "ECHO OFF" : _
PRINT #2, "CTTY GATE"+RIGHT$(ZComPort$,1) : _
PRINT #2, ZIPME$ : _
PRINT #2, "CTTY CON" : _
PRINT #2, "ECHO ON" : _
PRINT #2, "EXIT": _
CALL ShellExit (ZIP$)
'SHELL ZIPME$
'
' **** Check to see if Compresion was successfull if NOT then redo *****
ViewFileName$ = ZArkViewPath$ + "VIEW.ZIP" 'Pe 09/23/89 removed
CALL FindIt (ViewFileName$)
IF NOT ZOK THEN _
CALL QuickTPut ( "No files to Compress...you must use the X)tract command first" ,2) : _
CALL DelayTime (2) : _
GOTO 60140
'
'
'********** Tells the caller the name of the file to download **********
'
CALL QuickTPut (" File has been Compressed and named... VIEW.ZIP....",2)
CALL QuickTPut (CHR$(7)+"To Download this file You MUST enter VIEW.ZIP as the file name",2)
CALL DelayTime (3)
GOTO 60140
60180 END SUB
'
'
' $SUBTITLE: 'Error Handling for separately compiled subroutines'
' $PAGE
'
'
' Error handling for the separately compiled subroutines of RBBS-PC
'
'
65000 IF ZDebug THEN _
ZOutTxt$ = "RBBSSUB1 DEBUG Error Trap Entry ERL=" + _
STR$(ERL) + _
" ERR=" + _
STR$(ERR) : _
IF ZPrinter THEN _
CALL Printit(ZOutTxt$) _
ELSE CALL LPrnt(ZOutTxt$,1)
ZErrCode = ERR
'
' SetCall
'
IF ERL = 110 THEN _
RESUME NEXT
'
' OPEN CONFIG FILE
'
IF ERL => 117 AND ERL <= 119 THEN _
RESUME NEXT
'
' OPEN COM PORT ERROR HANDLING
'
IF ERL = 200 THEN _
CLS : _
CALL PScrn (ZComPort$ + " does not exist/not responding- Error" + STR$(ERR)) : _
STOP
'
' GetCom ERROR HANDLING
'
IF ERL = 1420 AND ERR = 57 THEN _
RESUME NEXT
IF ERL = 1420 AND ERR = 69 THEN _
ZSubParm = -1 :_
RESUME NEXT
'
' OPENRESEQ ERROR HANDLING
'
IF ERL = 1481 THEN _
ZErrCode = ERR : _
RESUME NEXT
'
' OpenUser ERROR HANDLING
'
IF ERL = 9400 AND ERR = 75 AND ZShareIt THEN _
CALL DelayTime (30) : _
RESUME
'
' FindUser ERROR HANDLING
'
IF ERL = 12610 THEN _
RESUME NEXT
'
' UpdtCalr ERROR HANDLING
'
IF ERL = 13663 THEN _
RESUME NEXT
IF ERL = 13672 AND ERR = 61 THEN _
CALL QuickTPut1 ("Disk Full") : _
IF ZDiskFullGoOffline THEN _
GOTO 65010 _
ELSE RESUME NEXT
IF ERL = 13672 THEN _
ZCallersFileIndex! = ZCallersFileIndex! - 1 : _
RESUME NEXT
'
' ZPrinter ERROR HANDLING
'
IF ERL = 13674 THEN _
ZPrinter = ZFalse : _
RESUME
'
' ChangeDir ERROR HANDLING
'
IF ERL = 20103 THEN _
ZOK = ZFalse : _
RESUME NEXT
'
' FindIt ERROR HANDLING
'
IF ERL = 20221 THEN _
RESUME NEXT
IF ERL = 20223 AND ZErrCode = 58 THEN _
ZErrCode = 64 : _
ZOK = ZFalse : _
RESUME NEXT
IF ERL = 20223 AND ZErrCode = 76 THEN _
CALL LPrnt("Bad path. File name is " + FilName$,1) : _
ZErrCode = 76 : _
ZOK = ZFalse : _
RESUME NEXT
IF ERL => 20221 AND ERL <= 20223 AND ZErrCode = 70 _
AND ZNetworkType = 6 THEN _
ZErrCode = 0 : _
RESUME NEXT
IF ERL => 20221 AND ERL <= 20223 THEN _
RESUME
'
' FlushCom ERROR HANDLING
'
IF ERL = 20310 AND ERR = 14 THEN _ 'Pe 01/03/90
RESUME NEXT 'Pe 01/03/90
IF ERL = 20311 AND ERR = 57 THEN _
RESUME NEXT
IF ERL = 20311 AND ERR = 69 THEN _
ZAbort = ZTrue : _
ZSubParm = -1 : _
RESUME NEXT
'
' FileLock ERROR HANDLER 'Pe 11/20/89
'
IF ERL => 21995 AND ERL <= 29830 THEN _ 'Pe 11/20/89
RESUME NEXT 'PE 11/20/89
'
' NetBIOS ERROR HANDLING
'
IF ERL => 29900 AND ERL <= 29920 THEN _
RESUME NEXT
'
' UpdateC ERROR HANDLING
'
IF ERL => 43050 AND ERL <= 43060 AND ERR = 61 THEN _
ZOutTxt$ = "* Disk full - terminating *" : _
ZSubParm =2 : _
CALL TPut : _
IF ZDiskFullGoOffline THEN _
GOTO 65010 _
ELSE SYSTEM
'
' CheckInt ERROR HANDLING
'
IF (ERL = 59652 OR ERL = 59727) AND ERR = 24 THEN _
ZNotCTS = ZTrue : _
CALL Line25 : _
ZErrCode = 0 : _
RESUME
IF ERL => 52000 AND ERL <= 59725 THEN _
RESUME NEXT
'
' FindFile ERROR HANDLING
'
IF ERL = 59791 THEN _ ' KG012802
IF ERR = 57 THEN _ ' AC012601
CALL DelayTime (1) : _ ' AC012601
CALL UpdtCalr ("SLOW I/O ERROR",1) : _ ' AC012601
IOErrorCount = IOErrorCount + 1 : _ ' AC012601
IF IOErrorCount < 11 THEN _ ' AC012601
RESUME ' AC012601
'
' Chat Door Error handleing
'
' IF (ERL = 59800 OR ERL = 59810) AND ERR = 70 THEN 'Pe 02/27/90
' RESUME
' END IF
'
' VIEW ARC TXT ERROR HANDLER
'
IF ERL = 60149 AND ERR = 53 THEN _
CALL QuickTPut ("ERROR !!! No Such File, EXITING",1):_
RESUME NEXT
IF ERL = 60149 AND ERR = 63 THEN _
CALL QuickTPut ("ERROR Occured, Please notify SysOp",1):_
RESUME NEXT
'
'
' DLVIEW ARC TXT ERROR HANDLER
'
IF ERL = 60170 AND ERR = 53 THEN _
CALL QuickTPut ("ERROR !!! No Such File, EXITING",1):_
RESUME NEXT
'
'
'
' CATCH ALL OTHER ERRORS
'
ZOutTxt$ = "RBBS-SUB1 Untrapped Error" + _
STR$(ERR) + _
" in line" + _
STR$(ERL)
CALL QuickTPut1 (ZOutTxt$)
CALL UpdtCalr (ZOutTxt$,2)
RESUME NEXT
' SHARED ROUTINE FOR GOING OFF LINE WHEN DISK FULL
65010 CALL OpenCom(ZModemInitBaud$,",N,8,1")
CALL TakeOffHook
SYSTEM